XGBoost wrapper

XGBoost wrapper for seurat project in R

source("tianfengRwrappers.R")
library(xgboost)
library(Matrix)
library(mclust)
library(tidyverse)
library(SHAPforxgboost)

ds0 <- readRDS("ds0.rds")
ds1 <- readRDS("ds1.rds")
ds2 <- readRDS("ds2.rds")

XGBoost_train_from_seuobj <- function(seuobj, is_highvar = T, test_ratio = 0.3, seed = 7)
  ## set test_ratio to 0 to avoid extracting test from dataset
{
  set.seed(seed)
  seuobj_label <- as.numeric(as.character(Idents(seuobj)))
  if(is.na(seuobj_label[1])) # check vaild Idents
    stop("Please ensure that seurat idents are in numeric forms")
  # colnames(seuobj_data) <- NULL
  seuobj_data <- get_data_table(seuobj, highvar = T, type = "data")
  xgb_param <- list(eta = 0.2, max_depth = 6, 
                    subsample = 0.6,  num_class = length(table(Idents(seuobj))),
                    objective = "multi:softprob", eval_metric = 'mlogloss')
  
  if(test_ratio == 0) {
    seuobj_train_data <- list(data = t(as(seuobj_data,"dgCMatrix")), label = seuobj_label) 
    # use whole dataset as train data
    seuobj_train <- xgb.DMatrix(data = seuobj_train_data$data,label = seuobj_train_data$label)
    bst_model <- xgb.train(xgb_param, seuobj_train, nrounds = 100, verbose = 0)
  } else {
    index <- c(1:dim(seuobj_data)[2]) %>% sample(ceiling(test_ratio*dim(seuobj_data)[2]), replace = F, prob = NULL)
    seuobj_train_data <- list(data = t(as(seuobj_data[,-index],"dgCMatrix")), label = seuobj_label[-index])
    seuobj_test_data <- list(data = t(as(seuobj_data[,index],"dgCMatrix")), label = seuobj_label[index])
    seuobj_test <- xgb.DMatrix(data = seuobj_test_data$data,label = seuobj_test_data$label)
    seuobj_train <- xgb.DMatrix(data = seuobj_train_data$data,label = seuobj_train_data$label)
    watchlist <- list(train = seuobj_train, eval = seuobj_test)
    bst_model <- xgb.train(xgb_param, seuobj_train, nrounds = 100, watchlist, verbose = 0)
  }
  return(bst_model)
}
# saveRDS(bst_model, "ds2_model.rds")

show_train_loss <- function(nrounds = 100) #when $ test_ratio \neq 0 $ show loss in watchlist
{
  eval_loss <- bst_model[["evaluation_log"]][["eval_mlogloss"]]
  plot_ly(data.frame(eval_loss), x = c(1:nrounds), y = eval_loss) %>% 
    add_trace(type = "scatter", mode = "markers+lines", 
              marker = list(color = "black", line = list(color = "#1E90FFC7", width = 1)),
              line = list(color = "#1E90FF80", width = 2)) %>% 
    layout(xaxis = list(title = "epoch"),yaxis = list(title = "eval_mlogloss"), 
           title = "train_loss", font = list(family = "Arial", size = 25, color = "black"))
}

---

function instance

train

function instance

predict

supervised vs unsupervised clustering

upset plot

library()

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

When you save the notebook, an HTML file containing the code and output will be saved alongside it (click the Preview button or press Ctrl+Shift+K to preview the HTML file).

The preview shows you a rendered HTML copy of the contents of the editor. Consequently, unlike Knit, Preview does not run any R code chunks. Instead, the output of the chunk when it was last run in the editor is displayed.